home *** CD-ROM | disk | FTP | other *** search
/ Shareware Extravaganza - Disc 1 / ShareWare Extravaganza 1 of 4 (The Ultimate Shareware Company).iso / sblaster / tpu60b.zip / TPU6UNA.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-16  |  24KB  |  948 lines
  1. UNIT TPU6UNA;
  2.  
  3. (*****************)
  4. (**) INTERFACE (**)             USES TPU6EQU, TPU6AMS;
  5. (*****************)
  6.  
  7. TYPE
  8.     OprStr = String[32];
  9.  
  10.     CpuGate = (C086,C186,C286,C386);
  11.  
  12.     ObjArg =
  13.         RECORD
  14.             Obj  : Word;    { Offset of text to Unassemble }
  15.             Lim  : Word;    { Max Bytes to Examine  }
  16.             TCpu : CpuGate; { Cpu code to handle }
  17.             Locn : Word;    { Code Offset }
  18.             Code : OprStr;    { Object Text in ASCII }
  19.             Mnem : OprStr;    { Mnemonic(s) in ASCII }
  20.             Opr1 : OprStr;    { ASCII Operand 1 }
  21.             Opr2 : OprStr;    { ASCII Operand 2 }
  22.             Opr3 : OprStr;    { ASCII Operand 3 }
  23.         END;
  24.  
  25. CONST    SegDBit : Boolean = FALSE; { Assume 16-Bit Addressing }
  26.  
  27. PROCEDURE UnAssemble(U : UnitPtr; VAR P : ObjArg);
  28.  
  29. (**********************)
  30. (**) IMPLEMENTATION (**)
  31. (**********************)
  32.  
  33. TYPE    { Types Below Used For Quick Classification of Op-Codes }
  34.  
  35.    Gating =
  36.     (G_RM1,     G_RM2,     G_RM3,     G_RM4,     G_RM5,
  37.      G_RM6,     G_RM7,     G_RM8,     G_RM9,        { modR/M Has op bits }
  38.      G_Hit,    { defined operation }
  39.      G_0Fx,    { 0F-type operation }
  40.      G_387,    { escapes to 80387  }
  41.      G_Pfx,    { prefix  operation }
  42.      G_ooo);   { invalid operation }
  43.  
  44.    Gate_2 =        { 2nd-level gates for G_0Fx Operations }
  45.     (Row_0,
  46.      Row_2,
  47.      Row_8,
  48.      Row_9,
  49.      Row_A,
  50.      Row_B,
  51.      Row_X);   { invalid otherwise }
  52.  
  53.    TAdr = (Adr16,Adr32);    {16-bit or 32-bit Addressing}
  54.    WBitStatus = (W0,W1);    {W1 = W-bit ON, else W0}
  55.    REGString = String[3];
  56.    TagRec =
  57.     RECORD
  58.         A : Char;    {tells type of operand}
  59.         V : Byte        {gives width/value etc}
  60.     END;
  61.    TagGrp = ARRAY[1..3] OF TagRec;
  62.  
  63.    CpuVec =
  64.     RECORD
  65.         F,    {Bit Flags for Processing Options}
  66.             {1xxx xxxx = alternate Mnemonic at M+1  }
  67.             {x1xx xxxx = 32-bit if OpSiz Prefix     }
  68.             {xx1x xxxx = 16-bit normally            }
  69.             {xxx1 xxxx = sign-extend immediates     }
  70.             {xxxx 1xxx = Op has modR/M field        }
  71.             {---- -ccc = Cpu Required for Op    }
  72.  
  73.         M,    {8086  Mnemonic Index}
  74.         T    {Operand Format Index}
  75.                             : Byte
  76.     END;
  77.  
  78.    MpuVec =                    {.CP27}
  79.     RECORD
  80.         F,    { Flag Bits (see below)
  81.             0000 0000 = INVALID operation
  82.             0010 xxxx = Entire modR/M byte defines op-code
  83.             0001 xxxx = modR/M REG field defines op-code
  84.  
  85.             xxxx 0000 = no explicit operand(s) coded
  86.             xxxx 0001 = operand is "AX"
  87.             xxxx 0010 = operand is "Bcd80"
  88.             xxxx 0011 = operand is "Ea" (no size implied)
  89.             xxxx 0100 = operand is "Ew" (16-bit word)
  90.             xxxx 0101 = operand is "Int16"
  91.             xxxx 0110 = operand is "Int32"
  92.             xxxx 0111 = operand is "Int64"
  93.             xxxx 1000 = operand is "Real32"
  94.             xxxx 1001 = operand is "Real64"
  95.             xxxx 1010 = operand is "Real80"
  96.             xxxx 1011 = operand is "ST(i)"
  97.             xxxx 1100 = operand is "ST(i),ST"
  98.             xxxx 1101 = operand is "ST,ST(i)"
  99.             xxxx 1110 = reserved
  100.             xxxx 1111 = reserved
  101.             }
  102.         M    { index to mnemonic table }
  103.                 : Byte
  104.     END;
  105.  
  106.  
  107.    TMrm =
  108.     RECORD
  109.         D,       { Size in Bytes of Displacement Field}
  110.         SIB,     { 1 -> SIB field present, else no SIB}
  111.         rS,      { index to Segment Register String   }
  112.         rB,      { index to  Base   Register String   }
  113.         rX       { index to  Index  Register String   }
  114.             : Byte
  115.     END;
  116.  
  117.    SibRec =
  118.     RECORD
  119.         D,      { displacement width (bytes) }
  120.         rS,     { default segment register   }
  121.         rB      { default base register      }
  122.             : Byte
  123.     END;
  124.  
  125.    sxRec =
  126.     RECORD
  127.         rX,  { to index reg name }
  128.         sF   { multiplier; if 0, ss must be too or illegal}
  129.             : Byte
  130.     END;
  131. {$I TPU6UNA.INC}
  132.  
  133. VAR                                    {.CP32}
  134.     Is_386Xtnsn,    Is_32BitMax,    Is_16BitMin,    Is_SignXtnd,
  135.     Is_MODrmFld,    HaveSizePfx,    HaveAddrPfx,    HaveMRM,
  136.     HaveSIB,    FetchFailure,    DSiz32,        ASiz32,
  137.     HaveSegPfx,    HaveInstPfx,    HaveMemOprnd    : Boolean;
  138.  
  139.     CpuAuth        : CpuGate;
  140.  
  141.     CodeByte,    PfxMax,        OprBytes,    DataByte,
  142.     DLoc,        mrmMOD,        mrmREG,        mrmRM,
  143.     IPfx,        sibSS,        sibNDX,        sibBAS,
  144.     EmuFlag,    SPfx                    : Byte;
  145.  
  146.     BytesFetched,    BytesRemaining,    PrefixBytes,    CodeSeg,
  147.     CodeOfs,    VirtualIP                : Word;
  148.  
  149.     REGOperand,    REGSeg,        REGBase,
  150.     REGIndex,    REGSegOvr            : REGString;
  151.  
  152.     EAOperand,    CodeText,    Mnemonic    : OprStr;
  153.  
  154.     CodeStack    : ARRAY[1..16] OF Byte;
  155.     Opnd         : ARRAY[1..3]  OF OprStr;
  156.     ActGroup    : CpuVec;
  157.     OpTags        : TagGrp;
  158.     NdxSF        : String[2];
  159.  
  160.     ByteGate    : Gating;
  161.     AddrMode    : TAdr;
  162.     WBitMode    : WBitStatus;
  163.  
  164.     { --------------------------------------------- } {.CP19}
  165.     { Fetches a Byte and stacks it for Disassembler }
  166.     { --------------------------------------------- }
  167.  
  168. FUNCTION FetchByte : Byte;
  169. BEGIN
  170.     FetchFailure := BytesRemaining = 0;
  171.     IF NOT FetchFailure THEN
  172.     BEGIN
  173.         Inc(BytesFetched);
  174.         {$R+}
  175.         CodeStack[BytesFetched] := Mem[CodeSeg:CodeOfs];
  176.         {$R-}
  177.         Dec(BytesRemaining);
  178.         Inc(CodeOfs);
  179.     END;
  180.         FetchByte := CodeStack[BytesFetched]
  181. END;
  182.  
  183.     { ----------------------------------------------- } {.CP14}
  184.     { Undoes the Fetch Byte Process - Pops From Stack }
  185.     { ----------------------------------------------- }
  186.  
  187. PROCEDURE UnFetchCodeByte;
  188. BEGIN
  189.     IF BytesFetched > 0 THEN
  190.     BEGIN
  191.         Dec(BytesFetched);
  192.         Inc(BytesRemaining);
  193.         Dec(CodeOfs);
  194.     END
  195. END;
  196.  
  197.     { ------------------------------------------------- } {.CP13}
  198.     { Formats a Sequence of Stacked Bytes as printable  }
  199.     { Hex in "logical" order - not processor order, and }
  200.     { appends a Padding String and a Blank            }
  201.     { ------------------------------------------------- }
  202.  
  203. PROCEDURE FormatText(Locn, SLen:Byte; Pad : String);
  204. VAR  W : OprStr; i : Byte;
  205. BEGIN
  206.     W := '';
  207.     FOR i := Locn TO Locn+SLen-1 DO W := HexB(CodeStack[i]) + W;
  208.     CodeText := CodeText + W + Pad + ' ';
  209. END;
  210.  
  211.     { ------------------- }    {.CP11}
  212.     { Unpacks modR/M Byte }
  213.     { ------------------- }
  214.  
  215. PROCEDURE UnPackModRM(modRM : Byte);
  216. BEGIN
  217.     HaveMRM := True;
  218.     mrmMOD := (modRM SHR 6) AND $03;
  219.     mrmREG := (modRM SHR 3) AND $07;
  220.     mrmRM  :=  modRM AND $07;
  221. END;
  222.  
  223.     { ---------------- } {.CP11}
  224.     { Unpacks SIB Byte }
  225.     { ---------------- }
  226.  
  227. PROCEDURE UnPackSIB(sib : Byte);
  228. BEGIN
  229.     HaveSIB := True;
  230.     sibSS   := (sib SHR 6) AND $03;
  231.     sibNDX  := (sib SHR 3) AND $07;
  232.     sibBAS  :=  sib AND $07;
  233. END;
  234.  
  235. PROCEDURE MergeActGrp(VAR Z : CpuVec);                {.CP10}
  236. VAR I,J : Byte;
  237. BEGIN
  238.     ActGroup.M := Z.M;
  239.     IF Z.T <> 0 THEN ActGroup.T := Z.T;
  240.     I := ActGroup.F AND $7;
  241.     J := Z.F AND $7;
  242.     IF I < J THEN I := J;
  243.     ActGroup.F := ((ActGroup.F OR Z.F) AND $F8) OR I;
  244. END;
  245.  
  246.     { ------------------------------------------------- } {.CP52}
  247.     { Formats a Sequence of Stacked Bytes as printable  }
  248.     { Hex in "logical" order - not processor order for  }
  249.     { use in Operand Expressions.  Lead zero suppressed }
  250.     { May be SIGNED or UN-SIGNED                        }
  251.     { ------------------------------------------------- }
  252.  
  253. PROCEDURE FormatDispl(VAR Sx:OprStr; Locn, SLen:Byte; Signed:Boolean);
  254. TYPE
  255.   MyWord = RECORD
  256.     CASE Byte OF
  257.         0: (Ds : ShortInt);
  258.         1: (Db : Byte);
  259.         2: (Dw : Word);
  260.         3: (Di : Integer);
  261.         4: (Dd : LongInt);
  262.         5: (Dv : ARRAY[1..4] OF Byte);
  263.     END;
  264.  
  265. VAR    W, X : MyWord; I : Byte; P : ^MyWord; Signit : Char;
  266. BEGIN
  267.     Sx := '';
  268.     IF SLen IN [1,2,4] THEN
  269.     BEGIN
  270.         P := @ CodeStack[Locn];
  271.         W.Dd := 0; X := W;
  272.         WITH P^ DO
  273.         IF Signed THEN
  274.         BEGIN            { sign extend for next step }
  275.             CASE SLen OF
  276.                 1: W.Dd := Ds;
  277.                 2: W.Dd := Di;
  278.                 4: W.Dd := Dd
  279.             END;
  280.             X.Dd := Abs(W.Dd)
  281.         END ELSE
  282.         BEGIN            { zero extend for next step }
  283.             CASE SLen OF
  284.                 1: W.Dd := Db;
  285.                 2: W.Dd := Dw;
  286.                 4: W.Dd := Dd
  287.             END;
  288.             X.Dd := W.Dd
  289.         END;
  290.         FOR i := 1 TO SLen DO Sx := HexB(X.Dv[i]) + Sx;
  291.         IF X.Dd <> W.Dd
  292.             THEN Signit := '-'
  293.             ELSE Signit := '+';
  294.         Sx := Sx + 'h';
  295.         IF Signed THEN Sx := Signit + Sx;
  296.     END;
  297. END; {FormatDispl}
  298.  
  299.     { ------------------------------------ }  {.CP24}
  300.     { ERROR - Stacked Code printed as DB's }
  301.     { ------------------------------------ }
  302.  
  303. PROCEDURE EmitConstants;
  304. VAR c : Char;
  305. BEGIN
  306.     WHILE BytesFetched > 1 DO UnFetchCodeByte;
  307.     Mnemonic := 'DB';
  308.     CodeText := '';
  309.     HaveInstPfx := False;
  310.     c := Char(CodeStack[1]);
  311.     CodeText := HexB(Byte(c));
  312.     CASE c OF
  313.         ' '..'&',
  314.         '('..#$7F:    Opnd[1] := '''' + c + '''';
  315.         ELSE        Opnd[1] := '0' + CodeText + 'h';
  316.     END;
  317.     Opnd[2] := '';
  318.     Opnd[3] := '';
  319.     { Ready to Build and Print Line }
  320. END;
  321.  
  322.     { --------------------- } {.CP08}
  323.     { Returns Register Name }
  324.     { --------------------- }
  325.  
  326. FUNCTION ExtractReg(Am : TAdr; Wbit : WBitStatus; Arg : Byte) : RegString;
  327. BEGIN
  328.     ExtractReg := RegList[RegDecode[Am,Wbit,Arg]]
  329. END;
  330.  
  331.     { ----------------------------------- } {.CP12}
  332.     { Fetches Displacement/Immediate Data }
  333.     { ----------------------------------- }
  334.  
  335. FUNCTION FetchDispl(Width:Byte) : Byte; { Index to LSB of Displ }
  336. VAR i, j : Byte;
  337. BEGIN
  338.     FOR i := 1 TO Width DO j := FetchByte;
  339.     IF FetchFailure
  340.         THEN FetchDispl := 0
  341.         ELSE FetchDispl := BytesFetched + 1 - Width;
  342. END;
  343.  
  344.     { ------------------------------- } {.CP05}
  345.     { Decodes and Stacks Prefix Bytes }
  346.     { ------------------------------- }
  347.  
  348. PROCEDURE HandlePrefix;
  349.  
  350.     PROCEDURE StowPrefix;                             {.CP45}
  351.     CONST PfxFlg : ARRAY[1..4] OF CHAR = '>||:';
  352.     VAR PfxCls : 1..4; i : Byte;
  353.     BEGIN
  354.         CASE CodeByte OF
  355.            $F0,    $F2..$F3:    BEGIN    {LOCK/REPE/REPNE}
  356.                         PfxCls := 1;
  357.                         IPfx := CodeByte;
  358.                         HaveInstPfx := True;
  359.                     END;
  360.             $67:        BEGIN   {Address Size Prefix}
  361.                         PfxCls := 2;
  362.                         ASiz32 := NOT SegDBit;
  363.                         HaveAddrPfx := True;
  364.                     END;
  365.             $66:        BEGIN   {Operand Size Prefix}
  366.                         PfxCls := 3;
  367.                         DSiz32 := NOT SegDBit;
  368.                         HaveSizePfx := True;
  369.                     END;
  370.             $26,$2E,
  371.             $36,$3E:    BEGIN   {Segment Prefix ES,CS,SS,DS}
  372.                         PfxCls := 4;
  373.                         SPfx := BytesFetched;
  374.                         HaveSegPfx := True;
  375.                         i := CodeByte SHR 3 AND $03;
  376.                         REGSegOvr := RegList[i + 24];
  377.                     END;
  378.             $64,$65:    BEGIN   {Segment Prefix FS,GS}
  379.                         PfxCls := 4;
  380.                         SPfx := BytesFetched;
  381.                         HaveSegPfx := True;
  382.                         i := CodeByte AND $07;
  383.                         REGSegOvr := RegList[i + 24];
  384.                     END;
  385.         END;
  386.         IF PfxCls > PfxMax THEN
  387.         BEGIN
  388.             Inc(PrefixBytes);
  389.             PfxMax := PfxCls;
  390.             FormatText(BytesFetched,1,PfxFlg[PfxCls]);
  391.         END ELSE
  392.         BEGIN
  393.             UnFetchCodeByte;   { will fetch again later  }
  394.             EmitConstants;     { emit code stack as DB's }
  395.             PrefixBytes := 0; PfxMax := 0;
  396.             HaveAddrPfx := False; HaveSizePfx := False;
  397.         END;
  398.     END; {StowPrefix}
  399.  
  400. BEGIN {HandlePrefix}                {.CP05}
  401.     IF NOT FetchFailure THEN
  402.     IF (ActLvl1[CodeByte].F AND $7) > Ord(CpuAuth) THEN
  403.     BEGIN   EmitConstants; ByteGate := G_ooo END ELSE
  404.     BEGIN
  405.         StowPrefix;
  406.         CodeByte := FetchByte;
  407.         IF NOT FetchFailure
  408.             THEN ByteGate := GateLvl1[CodeByte]
  409.             ELSE ByteGate := G_ooo;
  410.     END;
  411. END; {HandlePrefix}
  412.  
  413.     { -------------------------------------- } {.CP44}
  414.     { Interprets modR/M and optional SIB to  }
  415.     { get operand strings.  Fetches required }
  416.     { displacement fields if any.         }
  417.     { -------------------------------------- }
  418.  
  419. PROCEDURE DecodeModRM(W :WBitStatus);
  420. VAR wmrm : TMrm; wsib : SibRec; wsx : sxRec; Sx : OprStr;
  421. BEGIN
  422.     IF mrmMOD = 3 THEN EAOperand := ExtractReg(AddrMode,W,mrmRM)
  423.     ELSE
  424.     BEGIN
  425.         wmrm     := MrmTab[AddrMode,mrmMOD,mrmRM];
  426.         IF wmrm.SIB = 1 THEN
  427.         BEGIN
  428.             DataByte := FetchByte;
  429.             FormatText(BytesFetched,1,'');
  430.             UnPackSIB(DataByte);
  431.             wsib := SibTab[mrmMOD,sibBAS];
  432.             wsx  := sxTAB[sibSS,sibNDX];
  433.             wmrm.D := wsib.D;
  434.             wmrm.rS := wsib.rS;
  435.             wmrm.rB := wsib.rB;
  436.             wmrm.rX := wsx.rX;
  437.             IF wsx.SF = 0 THEN
  438.             BEGIN
  439.                 NdxSF := '';
  440.                 wmrm.rX := 30     { null register string }
  441.             END
  442.             ELSE NdxSF := '*'+Chr(Ord('0')+wsx.SF);
  443.                 END;
  444.  
  445.         DLoc := FetchDispl(wmrm.D);
  446.         FormatText(DLoc,wmrm.D,'');
  447.         FormatDispl(Sx,DLoc,wmrm.D,True);
  448.         REGSeg   := RegList[wmrm.rS];
  449.         REGBase  := RegList[wmrm.rB];
  450.         REGIndex := RegList[wmrm.rX];
  451.         EAOperand := REGBase;
  452.         IF Length(REGIndex) > 0
  453.         THEN EAOperand := EAOperand + '+' + REGIndex + NdxSF;
  454.         IF wmrm.D > 0 THEN  EAOperand := EAOperand + Sx;
  455.     END;
  456.     REGOperand := ExtractReg(AddrMode,W,mrmREG);
  457. END;
  458.  
  459.     { ---------------------------------- }            {.CP08}
  460.     { Main Driver for 80386 Operand Edit }
  461.     { ---------------------------------- }
  462.  
  463. PROCEDURE Edit386Ops;
  464. VAR
  465.     OpEdit        : TagRec;    Sx    : OprStr;
  466.     i               : Byte;
  467.  
  468.     PROCEDURE EditSplRegs(j : Byte); { CRx,DRx,TRx }    {.CP04}
  469.     BEGIN
  470.         Opnd[j] := OpEdit.A + 'R' + Chr(Ord('0')+mrmREG);
  471.     END;
  472.  
  473.     PROCEDURE EditDblRegs(j : Byte); { EAX..EDI }        {.CP04}
  474.     BEGIN
  475.         Opnd[j] := RegList[16+mrmREG];
  476.     END;
  477.  
  478.     PROCEDURE EditSegRegs(j : Byte); { ES:..GS: }        {.CP04}
  479.     BEGIN
  480.         Opnd[j] := RegList[24+mrmREG];
  481.     END;
  482.  
  483.     PROCEDURE EditLiteral(j : Byte); { literal data }    {.CP04}
  484.     BEGIN
  485.         Opnd[j] := RegList[OpEdit.V];
  486.     END;
  487.  
  488.     PROCEDURE EditGprRegs(j : Byte); { Gb,Gw,Gd,Gv }    {.CP04}
  489.     BEGIN
  490.         Opnd[j] := REGOperand;
  491.     END;
  492.  
  493.     PROCEDURE EditJmpDspl(j : Byte); { Jb, Jv }        {.CP17}
  494.         TYPE
  495.           MyWord = RECORD
  496.         CASE Byte OF
  497.         0: (Ds : ShortInt);
  498.         1: (Db : Byte);
  499.         2: (Dw : Word);
  500.         3: (Di : Integer);
  501.         4: (Dd : LongInt);
  502.         5: (Dv : ARRAY[1..4] OF Byte);
  503.         END;
  504.  
  505.     VAR P : ^MyWord; i,k : Byte; l : LongInt;
  506.     BEGIN
  507.         IF RegList[OpEdit.V][1] = 'b' THEN
  508.         BEGIN
  509.             i := FetchDispl(1);
  510.                         FormatText(i,1,'');
  511.             P := @ CodeStack[i];
  512.             l := CodeOfs + P^.Ds;
  513.             P := @l;
  514.             Opnd[j] := 'SHORT ' + HexB(Hi(P^.Dw))+HexB(Lo(P^.Dw))+'h';
  515.         END ELSE
  516.         BEGIN
  517.             IF ASiz32 THEN k := 4 ELSE k := 2;
  518.             i := FetchDispl(k);        { Displacement }
  519.             FormatText(i,k,'');
  520.                         P := @ CodeStack[i];
  521.                         IF ASiz32
  522.                THEN l := CodeOfs + P^.Dd
  523.                ELSE l := CodeOfs + P^.Di;
  524.             P := @l;
  525.             Opnd[j] := 'h';
  526.             FOR i := 1 TO k DO
  527.                 Opnd[j] := HexB(P^.Dv[i]) + Opnd[j]
  528.         END;
  529.     END;
  530.  
  531.     PROCEDURE EditPointer(j : Byte); { Ap }            {.CP13}
  532.     VAR i,k : Byte;
  533.     BEGIN
  534.         IF ASiz32 THEN k := 4 ELSE k := 2;
  535.         i := FetchDispl(k);            { Displacement }
  536.         FormatText(i,k,'r');
  537.         FormatDispl(Sx,i,k,False);
  538.         k := 2;
  539.         i := FetchDispl(k);            { Selector }
  540.         FormatText(i,k,'s');
  541.         FormatDispl(Opnd[j],i,k,False);
  542.         Opnd[j] := Opnd[j] + ':' + Sx;
  543.     END;
  544.  
  545.     PROCEDURE EditImmData(j : Byte);  { Ib, Iv, Iw }    {.CP17}
  546.     VAR i,k : Byte;
  547.     BEGIN
  548.         CASE RegList[OpEdit.V][1] OF
  549.             'b':    k := 1;
  550.             'w':    k := 2;
  551.             'v':    IF DSiz32 THEN k := 4 ELSE k := 2;
  552.             ELSE    k := 0
  553.         END; {CASE}
  554.         IF k > 0 THEN
  555.         BEGIN
  556.             i := FetchDispl(k);
  557.             FormatText(i,k,'');
  558.             FormatDispl(Sx,i,k,Is_SignXtnd);
  559.             Opnd[j] := Sx;
  560.         END;
  561.     END;
  562.  
  563.     PROCEDURE EditMemAddr(j : Byte);            {.CP04}
  564.     BEGIN
  565.         Opnd[j] := '';
  566.         IF HaveSegPfx   THEN Opnd[j] := REGSegOvr + ': ';
  567.         Opnd[j] := '['+ Opnd[j] + EAOperand + ']';
  568.         HaveMemOprnd := True;
  569.     END;
  570.  
  571.     PROCEDURE EditOfsDspl(j : Byte); { Ob, Ov }        {.CP16}
  572.     VAR i,k : Byte;
  573.     BEGIN
  574.         CASE RegList[OpEdit.V][1] OF
  575.             'b':    k := 2;
  576.             'v':    IF ASiz32 THEN k := 4 ELSE k := 2;
  577.             ELSE    k := 0
  578.         END; {CASE}
  579.         IF k > 0 THEN
  580.         BEGIN
  581.             i := FetchDispl(k);        { Offset }
  582.             FormatText(i,k,'');
  583.             FormatDispl(Sx,i,k,False);
  584.             IF HaveSegPfx AND (mrmMOD <> 3)
  585.                 THEN Sx := REGSegOvr + ': ' + Sx;
  586.             Opnd[j] := '[' + Sx + ']';
  587.             HaveMemOprnd := True;
  588.         END;
  589.     END;
  590.  
  591.     PROCEDURE EditEffAddr(j : Byte); { Eb, Ew, Ev, Ep }    {.CP22}
  592.     BEGIN
  593.         Sx := '';
  594.         IF mrmMOD <> 3 THEN
  595.         IF j = 1 THEN
  596.         CASE RegList[OpEdit.V][1] OF
  597.             'b':    Sx := 'BYTE';
  598.             'w':    Sx := 'WORD';
  599.             'v':    IF DSiz32
  600.                 THEN Sx := 'DWORD'
  601.                 ELSE Sx := 'WORD';
  602.             'p':    IF ASiz32
  603.                 THEN Sx := 'FWORD'
  604.                 ELSE Sx := 'DWORD';
  605.             'q':    Sx := 'QWORD';
  606.             't':    Sx := 'TBYTE';
  607.             'd':    Sx := 'DWORD';
  608.         END; {CASE}
  609.         IF Sx <> '' THEN Sx := Sx + ' PTR ';
  610.         IF HaveSegPfx AND (mrmMOD <> 3)
  611.             THEN Sx := REGSegOvr + ': ' + Sx;
  612.         Opnd[j] := Sx + EAOperand;
  613.         IF mrmMOD <> 3
  614.         THEN BEGIN
  615.             Opnd[j] := '[' + Opnd[j] + ']';
  616.             HaveMemOprnd := True;
  617.              END;
  618.     END;
  619.  
  620.     PROCEDURE EditVarRegs(j : Byte); { eAX..eDI }        {.CP04}
  621.     BEGIN
  622.         Opnd[j] := RegList[OpEdit.V+(Ord(DSiz32) SHL 3)];
  623.     END;
  624.  
  625. BEGIN   {Edit386Ops}                                        {.CP22}
  626.  
  627.     FOR i := 1 TO 3 DO BEGIN
  628.         OpEdit := OpTags[i];
  629.         Opnd[i] := '';
  630.         CASE OpEdit.A OF
  631.             'C',
  632.             'D',
  633.             'T':    EditSplRegs(i);
  634.             'A':    EditPointer(i);
  635.             'R':    EditDblRegs(i);
  636.             'S':    EditSegRegs(i);
  637.             'G':    EditGprRegs(i);
  638.             'J':    EditJmpDspl(i);
  639.             'I':    EditImmData(i);
  640.             'M':    EditMemAddr(i);
  641.             'O':    EditOfsDspl(i);
  642.             'E':    EditEffAddr(i);
  643.             'e':    EditVarRegs(i);
  644.             'r':    EditLiteral(i);
  645.         END; {CASE}
  646.     END;
  647. END; {Edit386Ops}
  648.  
  649. PROCEDURE RemovePrefix;
  650. BEGIN
  651.     WHILE BytesFetched > SPfx DO UnFetchCodeByte;
  652.     IF SPfx <> 1 THEN
  653.     BEGIN
  654.         UnFetchCodeByte;
  655.         EmitConstants;
  656.     END ELSE
  657.     BEGIN
  658.         CodeByte := CodeStack[SPfx];
  659.         CodeText := '';
  660.         FormatText(SPfx,1,'');
  661.         ActGroup := ActLvl1[CodeByte];
  662.         Opnd[1] := '';
  663.         Opnd[2] := '';
  664.         Opnd[3] := '';
  665.         Mnemonic := Mnem386[ActGroup.M];
  666.     END;
  667. END;
  668.  
  669.     { ---------------------------------- } {.CP05}
  670.     { Main Driver for 80386 Instructions }
  671.     { ---------------------------------- }
  672.  
  673. PROCEDURE Handle386Op;
  674. VAR i : Byte; OGate : Gating;
  675.  
  676.     PROCEDURE UpdateTags(n : Byte);
  677.     VAR i : Byte;
  678.     BEGIN
  679.       FOR i := 1 TO 3 DO
  680.         IF OpType386[n,i].A <> ' ' THEN OpTags[i] := OpType386[n,i];
  681.     END;
  682.  
  683.     PROCEDURE HandleOpMRM;                 {.CP17}
  684.     BEGIN
  685.         DataByte := FetchByte;
  686.         IF NOT FetchFailure THEN
  687.         BEGIN
  688.             FormatText(BytesFetched,1,'');
  689.             UnPackModRM(DataByte);
  690.             OGate := ByteGate;
  691.             ByteGate := GateLvl3[ByteGate,mrmREG];
  692.             IF ByteGate = G_Hit THEN
  693.             BEGIN
  694.                 MergeActGrp(ActLvl3[OGate,mrmREG]);
  695.                 UpdateTags(ActGroup.T);
  696.             END;
  697.         END;
  698.     END; {HandleOpMRM}
  699.  
  700.     PROCEDURE HandleOp0Fx;                  {.CP19}
  701.     VAR RowNdx : Gate_2; ColNdx : $0..$F;
  702.     BEGIN
  703.         CodeByte := FetchByte;
  704.         IF NOT FetchFailure THEN
  705.         BEGIN
  706.             FormatText(BytesFetched,1,'');
  707.             RowNdx := GateLvX2[(CodeByte SHR 4) AND $0F];
  708.             ColNdx := CodeByte AND $0F;
  709.             ByteGate := GateLvl2[RowNdx,ColNdx];
  710.             CASE ByteGate OF
  711.                G_Hit: BEGIN
  712.                     MergeActGrp(ActLvl2[RowNdx,ColNdx]);
  713.                     UpdateTags(ActGroup.T);
  714.                   END;
  715.                G_RM6..G_RM8: HandleOpMRM;
  716.             END; {CASE}
  717.         END;
  718.     END; {HandleOp0FX}
  719.  
  720. BEGIN  {Handle386Op}                {.CP34}
  721.     FormatText(BytesFetched,1,'');
  722.     WITH ActLvl1[CodeByte] DO BEGIN
  723.         ActGroup.F := F;
  724.         ActGroup.M := M;
  725.         ActGroup.T := T;
  726.         OpTags := OpType386[ActGroup.T];
  727.     END;
  728.     Case ByteGate OF
  729.         G_RM1..G_RM9:    HandleOpMRM;
  730.         G_0Fx:        HandleOp0Fx;
  731.         G_Hit:;
  732.     END;
  733.     IF (ActGroup.F AND $7) > Ord(CpuAuth) THEN ByteGate := G_ooo;
  734.     IF NOT FetchFailure AND (ByteGate <> G_ooo) THEN
  735.     BEGIN
  736.         Is_386Xtnsn := (ActGroup.F AND _386Xtnsn) = _386Xtnsn;
  737.         Is_32BitMax := (ActGroup.F AND _32BitMax) = _32BitMax;
  738.         Is_16BitMin := (ActGroup.F AND _16BitMin) = _16BitMin;
  739.         Is_SignXtnd := (ActGroup.F AND _SignXtnd) = _SignXtnd;
  740.         Is_MODrmFld := (ActGroup.F AND _MODrmFld) = _MODrmFld;
  741.         IF Is_MODrmFld AND NOT HaveMRM THEN
  742.         BEGIN
  743.             CodeByte := FetchByte;
  744.             IF NOT FetchFailure THEN UnPackModRM(CodeByte);
  745.             FormatText(BytesFetched,1,'');
  746.         END;
  747.         IF Is_32BitMax OR Is_16BitMin THEN WBitMode := W1;
  748.     END;
  749.     IF FetchFailure OR (ByteGate = G_ooo) OR (ActGroup.M = 0)
  750.     THEN EmitConstants ELSE
  751.     BEGIN
  752.         IF DSiz32 AND Is_386Xtnsn
  753.             THEN Mnemonic := Mnem386[ActGroup.M+1]
  754.             ELSE Mnemonic := Mnem386[ActGroup.M];
  755.         IF HaveMRM THEN DecodeModRM(WBitMode);
  756.         Edit386Ops;
  757.         IF HaveSegPfx AND (NOT HaveMemOprnd)
  758.         THEN RemovePrefix ELSE
  759.         BEGIN
  760.             EmuFlag := 0;
  761.             IF (BytesFetched = 2) AND (CodeStack[1] = $CD) THEN
  762.                 CASE CodeStack[2] OF
  763.                     $34..$3B,
  764.                     $3E: BEGIN
  765.                         EmuFlag := CodeStack[2];
  766.                         Opnd[3] := '; F-P Emulator Linkage';
  767.                          END;
  768.                     $3C: BEGIN
  769.                         EmuFlag := CodeStack[2];
  770.                         Opnd[3] := '; Emulated SEG Prefix';
  771.                          END;
  772.                     $3D: Opnd[3] := '; Emulated FWAIT ';
  773.                 END;
  774.         END;
  775.         { emit instruction }
  776.     END;
  777. END; {Handle386Op}
  778.  
  779.     { ----------------------------------------- }        {.CP50}
  780.     { Main driver for Co-Processor Instructions }
  781.     { ----------------------------------------- }
  782.  
  783. PROCEDURE Handle387Op(Emulation : Boolean);
  784. CONST T : ARRAY[2..10] OF Byte = (41,37,39,39,35,40,35,40,41);
  785. VAR esc,flaga,flagop :byte; MpuAux : MpuVec;
  786.     stkr : char;
  787.  
  788. BEGIN
  789.     esc := CodeByte AND $07;
  790.     IF NOT Emulation THEN FormatText(BytesFetched,1,'');
  791.     CodeByte := FetchByte;
  792.     IF NOT FetchFailure THEN UnPackModRM(CodeByte);
  793.     FormatText(BytesFetched,1,'');
  794.     IF mrmMOD = 3 THEN
  795.     BEGIN
  796.         MpuAux   := MpuM11[esc,mrmREG];    {flags,link}
  797.         MpuAux.M := MpuOv[MpuAux.M,mrmRM]  { mnemonic }
  798.     END
  799.     ELSE
  800.         MpuAux   := MpuEA[esc,mrmREG];     {flags,mnemonic}
  801.  
  802.     flaga  := MpuAux.F SHR 4;
  803.     IF flaga = 0 THEN EmitConstants ELSE
  804.     BEGIN
  805.         flagop := MpuAux.F AND $0F;
  806.         stkr   := Chr(Ord('0')+mrmRM);
  807.         CASE flagop OF
  808.              0:     Opnd[1] := '';
  809.              1:     Opnd[1] := 'AX';
  810.              2..10:     BEGIN
  811.                     DecodeModRM(W0);
  812.                     OpTags := OpType386[96];
  813.                     OpTags[1].V := T[flagop];
  814.                     Edit386Ops;
  815.                 END;
  816.             11:     Opnd[1] := 'ST('+stkr+')';
  817.             12:     Opnd[1] := 'ST('+stkr+'),ST';
  818.             13:     Opnd[1] := 'ST,ST('+stkr+')';
  819.         END;
  820.         Mnemonic := Mnem387[MpuAux.M];
  821.         Opnd[2] := '';
  822.         Opnd[3] := '';
  823.         { Emit Instruction Here }
  824.     END;
  825. END; {Handle387Op}
  826.  
  827.     { ----------------------------------------- }     {.CP17}
  828.     { Main Driver for ALL Instruction Sequences }
  829.     { ----------------------------------------- }
  830.  
  831. PROCEDURE HandleInstruction;
  832. BEGIN
  833.     ByteGate := GateLvl1[CodeByte];
  834.     WHILE ByteGate = G_Pfx DO HandlePrefix;
  835.     IF ASiz32 THEN AddrMode := Adr32 ELSE AddrMode := Adr16;
  836.     IF NOT FetchFailure    THEN
  837.         CASE ByteGate OF
  838.             G_RM1..G_0Fx:    Handle386Op;  {Get Op and modR/M}
  839.             G_387:         Handle387Op(False); { Ndp Ops   }
  840.             ELSE        EmitConstants {Invalid Op Codes }
  841.         END;
  842. END;
  843.  
  844.     { -------------------------------- }        {.CP34}
  845.     { Initialize for Instruction Fetch }
  846.     { -------------------------------- }
  847.  
  848. PROCEDURE StartOpFetch; { Initializes for next Instruction }
  849. BEGIN
  850.     Is_386Xtnsn    := False;    Is_32BitMax    := False;
  851.     Is_16BitMin    := False;    Is_SignXtnd     := False;
  852.     Is_MODrmFld     := False;
  853.     HaveSizePfx    := False;    HaveAddrPfx     := False;
  854.     HaveMRM         := False;    HaveSIB        := False;
  855.     FetchFailure    := False;       HaveMemOprnd    := False;
  856.     HaveInstPfx    := False;    HaveSegPfx    := False;
  857.     ASiz32        := SegDBit;    DSiz32        := SegDBit;
  858.  
  859.     CodeByte    := 0;        OprBytes    := 0;
  860.     BytesFetched    := 0;        mrmMOD        := 0;
  861.     mrmREG        := 0;        mrmRM        := 0;
  862.     sibSS        := 0;        sibNDX        := 0;
  863.     sibBAS        := 0;        PfxMax          := 0;
  864.     PrefixBytes    := 0;        DLoc        := 0;
  865.     SPfx        := 0;
  866.  
  867.     CodeText    := '';        NdxSF        := '';
  868.     EAOperand    := '';        REGSeg        := '';
  869.     REGBase        := '';        REGIndex    := '';
  870.     REGOperand    := '';        REGSegOvr    := '';
  871.  
  872.     WBitMode    := W0;        AddrMode    := Adr16;
  873.     ActGroup.F    := 0;        ActGroup.M    := 0;
  874.     ActGroup.T    := 0;           VirtualIP    := CodeOfs;
  875.  
  876.     CodeByte := FetchByte;
  877. END;
  878.  
  879.     { ------------------------------------- }    {.CP11}
  880.     { Prototype For Disassembly of One Line }
  881.     { ------------------------------------- }
  882.  
  883. PROCEDURE DisassembleLine;
  884. BEGIN
  885.     StartOpFetch;
  886.     CASE EmuFlag OF           {Handle Turbo F-P Emulator Expansions}
  887.         $34..$3B : BEGIN
  888.                 UnFetchCodeByte;
  889.                 CodeByte := EmuFlag + $A4;
  890.                 Handle387Op(True);
  891.                 Mnemonic := 'EMU_'+Mnemonic;
  892.                 EmuFlag := 0;
  893.                 Opnd[3] := '; Emulated Operation';
  894.                END;
  895.         $3C:       BEGIN
  896.                 HaveSegPfx := True;
  897.                 REGSegOvr := RegList[24+(CodeByte SHR 6 XOR 3)];
  898.                 Handle387Op(False);
  899.                 Mnemonic := 'EMU_'+Mnemonic;
  900.                 EmuFlag := 0;
  901.                 Opnd[3] := '; Emulated Operation';
  902.                END;
  903.         $3E:       BEGIN  { DB xxH for parameters }
  904.                 EmitConstants;
  905.                 Opnd[3] := '; Fast Path Emulations ';
  906.                 EmuFlag := 0;
  907.                END;
  908.         ELSE BEGIN
  909.             HandleInstruction;
  910.             IF HaveInstPfx
  911.             THEN
  912.               Mnemonic := Mnem386[ActLvl1[IPfx].M] + ' ' + Mnemonic;
  913.              END
  914.     END; {CASE}
  915. END;
  916.  
  917. PROCEDURE UnAssemble(U : UnitPtr; VAR P : ObjArg);
  918. BEGIN
  919.     WITH P DO BEGIN
  920.         IF NOT (TCpu IN [C086..C386]) THEN TCpu := C086;
  921.         CpuAuth := TCpu;
  922.         CodeSeg := Seg(BufPtr(U)^.BufByt[Obj]);
  923.         CodeOfs := Ofs(BufPtr(U)^.BufByt[Obj]);
  924.         BytesRemaining := Lim;
  925.         VirtualIP := Obj;
  926.         Locn := 0;
  927.         Code := '';
  928.         Mnem := '';
  929.         Opr1 := '';
  930.         Opr2 := '';
  931.         Opr3 := '';
  932.     END;
  933.     DisAssembleLine;
  934.     WITH P DO BEGIN
  935.         Obj  := Obj+BytesFetched;
  936.         Lim  := BytesRemaining;
  937.         Code := CodeText;
  938.         Mnem := Mnemonic;
  939.         Opr1 := Opnd[1];
  940.         Opr2 := Opnd[2];
  941.         Opr3 := Opnd[3];
  942.         Locn := VirtualIP;
  943.     END;
  944. END;
  945. BEGIN
  946.     EmuFlag := $0;    {No Borland/Microsoft F-P Emulator in Progress}
  947. END.
  948.